perm filename ARITH.FAI[XGP,BGB] blob
sn#038134 filedate 1973-05-11 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00004 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 SUBR(SQRT)
C00006 00003 BEGIN SINCOS MODIFIED OLDE LIB40 SINE & COSINE - BGB.
C00008 00004 SUBR(REALIN)
C00011 ENDMK
C⊗;
;SUBR(SQRT)
TITLE ARITH
SUBR(SQRT)--------------------------------------------------------
BEGIN SQRT;MODIFIED OLDE LIB40 SQUARE ROOT - BGB - TRADITIONAL.
A←0 ↔ B←1 ↔ C←2
MOVM B,ARG1↔JUMPE B,POP1J.↔PUSH P,2
;LET X=F*(2↑2B) WHERE 0.25<F<1.00 THEN SQRT(X)=SQRT(F)*(2↑B).
ASHC B,-=27↔SUBI B,201 ;GET EXPONENT IN B, FRACTION IN C.
ROT B,-1 ;CUT EXP IN HALF, SAVE ODD BIT
HRRM B,L↔LSH B,-=35 ;USE THAT ODD BIT.
ASH C,-10↔FSC C,177(B) ;0.25 < FRACTION < 1.00
;LINEAR APPROXIMATION TO SQRT(F).
MOVEM C,A
FMP C,[0.8125↔0.578125](B)
FAD C,[0.302734↔0.421875](B)
;TWO ITERATIONS OF NEWTON'S METHOD.
MOVE B,A
FDV B,C↔FAD C,B↔FSC C,-1
FDV A,C↔FADR A,C
L: FSC A,0↔MOVE 1,A↔POP P,2
POP1J↔LIT
BEND;28/12/72-----------------------------------------------------
BEGIN SINCOS ;MODIFIED OLDE LIB40 SINE & COSINE - BGB.
INTERN SIN,COS;---------------------------------------------------
A←1 ↔ B←2 ↔ C←3
↑COS: SKIPA A,ARG1
↑SIN: SKIPA A,ARG1
FADR A,HALFPI ;COS(X) = SIN(X+π/2).
MOVM B,A↔CAMG B,[17B5]↔POP1J ;FOR SMALL X, SIN(X)=X.
;B ← (ABS(X)MODULO 2π)/HALFPI
;C ← QUADRANT 0, 1, 2 OR 3.
FDVR B,HALFPI
LAC C,B↔FIX C,233000
CAILE C,3↔GO[
TRZ C,3↔FSC C,233
FSBR B,C↔GO .-3] ;MODULO 2π.
GO .+1(C)↔GO .+4↔JFCL↔GO[
FSBRI B,(2.0)↔MOVNS B↔GO .+2] ;SIN(X+π)=SIN(-X)
FSBRI B,(4.0) ;SIN(X+2π)=SIN(X)
SKIPGE A↔MOVNS B ;SIN(-X) = -SIN(X).
;FOR -1 ≤ B ≤ +1 REPRESENTING -π/2 ≤ X ≤ +π/2,
;COMPUTE SINE(X) APPROXIMATION BY TAYLOR SERIES.
DAC B,C↔FMPR B,B
LAC A,[164475536722]↔FMP A,B
FAD A,[606315546346]↔FMP A,B
FAD A,[175506321276]↔FMP A,B
FAD A,[577265210372]↔FMP A,B
FAD A,HALFPI↔FMPR A,C↔POP1J
HALFPI: 201622077325 ;PI/2
LIT
BEND;-------------------------------------------------------------
SUBR(REALIN)
BEGIN REALIN;
;<EXPR> ::= <EXPR>+<TERM>|<EXPR>-<TERM>|<TERM>
;<TERM> ::= <TERM>*<PRIMARY>|<TERM>/<PRIMARY>|<PRIMARY>
;<PRIMARY> ::= -<PRIMARY>|(<EXPR>)||π|<REAL NUMBER>
CALL(TERM)
CAIN 1,"+"
GO [ PUSH P,0
CALL(TERM)
FADR 0,(P)
SUB P,[XWD 1,1]
GO REALIN+1 ]
CAIN 1,"-"
GO [ PUSH P,0
CALL(TERM)
MOVN 0,0
FADR 0,(P)
SUB P,[XWD 1,1]
GO REALIN+1 ]
CAIN 1,15
INCHWL 1
POP0J
POP0J
TERM: CALL(PRIMARY)
TERM2: CAIN 1,"*"
GO [ PUSH P,0
CALL(PRIMARY)
FMPR 0,(P)
SUB P,[XWD 1,1]
GO TERM2 ]
CAIN 1,"/"
GO [ PUSH P,0
CALL(PRIMARY)
EXCH 0,(P)
FDVR 0,(P)
SUB P,[XWD 1,1]
GO TERM2 ]
POP0J
;BEGIN REALIN ; INPUT SMALL REAL NUMBER - BGB - 16 DEC 1972
;AC-0 INTEGER ACCUMULATION. AC-0 RETURNS REAL NUMBER.
;AC-1 CHARACTER. AC-1 RETURNS BREAK CHARACTER.
;AC-2 COUNTER OF DIGITS TO RIGHT OF DECIMAL POINT PLUS ONE.
;AC-3 MINUS SIGN FLAG.
PRIMARY:SETZ↔SETZB 2,3
L0: INCHWL 1
CAIN 1," "↔GO .-2
CAIN 1,"-"↔GO[SETCMM 3↔GO L0]
CAIN 1,"π"↔GO[MOVE 0,[3.1415926]
GETRET: INCHWL 1↔GO L3]
CAIN 1,"("↔GO[PUSH P,3↔CALL(REALIN)↔POP P,3
CAIN 1,")"↔GO GETRET
OUTSTR[ASCIZ/WARNING: MISSING ')'
/]↔ POP0J]
SKIPA
L1: INCHWL 1
CAIE 1,"."↔GO .+3↔JUMPN 2,L2↔AOJA 2,L1
CAIL 1,"0"↔CAILE 1,"9"↔GO L2
JUMPN 2,[CAILE 2,4↔GO L1↔AOJA 2,.+1]
ANDI 1,17↔IMULI =10↔ADD 1↔GO L1
L2: FLOAT↔SOSLE 2↔FDVR[1.0↔10.0↔100.0↔1000.0↔10000.0](2)
L3: SKIPE 3↔MOVNS↔POP0J
BEND REALIN;12/16/72(BGB),14-MAR-73(TVR)-----------------------------
END;